home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / More classes / Multitasking < prev    next >
Text File  |  1992-10-29  |  13KB  |  398 lines
  1. \ Multitasking.  April 88.
  2.  
  3. \ Feb 90 - M stack refs removed for Mops 1.2.
  4.  
  5. \ One of the beauties of a Forth-based system is that it is easy to implement multitasking.  This allows us to do interesting things like continue processing while a window is being dragged etc.  Most Mac applications can't manage this.  It makes our applications look unbelievably sophisticated, and yet this code is only about 2500 bytes.  This is possible because the Forth approach to multitasking, as usual, simplifies things considerably compared with other systems.
  6.  
  7. \ The main simplifying factor is that the scheme is cooperative.  Tasks cannot be interrupted at any arbitrary point, but must execute PAUSE to allow other tasks to have a turn.  This allows the overhead for switching tasks to be just about 20 machine instructions.
  8.  
  9. \ This code is based on that in the Laxen/Perry F83, including the extra features added by yours truly in the PDP-11 implementation, notably the mechanism to keep track of the status of a task.  We make some necessary Mac and Mops adaptations here - in particular, a task becomes a Mops object, and we set the various user hook locations (e.g. DragHook) to point to a routine to run the task round-robin.  Another addition is that each task has a queue of tasks waiting on it.  This avoids a waiting task having to waste time testing the other task each time round.  A waiting task can now be put to sleep, and the time penalty for each waiting task is reduced to one machine JMP instruction each time round the task loop. If it was worth it, we could even remove the task from the loop altogether, but it probably isn't worth it.
  10.  
  11. \ Another necessary Mac adjustment is that we must distinguish between a foreground task and various background tasks.  Any time WaitNextEvent is called, all kinds of things can happen which can use several K of stack space.  Therefore we assume in allocating this space that WNE will only be called from the foreground task, and we don't need to allocate as much stack space for background tasks.  Also, the hook procedures must be able to ensure that WNE will not be called during their execution (very illegal).  If we call WNE only from the foreground task, there's no problem.  The hook procedures then always execute as part of the foreground task (they're called by the system at WNE time), and even if they give background tasks some time before they return, these background tasks won't be calling WNE.
  12.  
  13. \ Another thing to watch is that a background task shouldn't do any drawing to the screen  Not only doesn't it know which GrafPort is switched in, I have also found QuickDraw doing some strange things in the "unused" area of the stack between BufPtr and the current A7 stack pointer!!  We therefore now put the foreground stack LOWEST in memory - this necessitates moving the stack when a background task is allocated, but at least it avoids any problems with QuickDraw, since, assuming QuickDraw calls only result from foreground tasks, the stack pointer at system call time will really represent the lowest address we need for any of our stacks.
  14.  
  15. \ Our general philosophy, then, is that the foreground task will look after the user interface, do all drawing to the screen, and manage the event loop.  It will delegate any lengthy computation to background tasks, which therefore just function as computing engines for the foreground.
  16.  
  17. \ Things would have been a lot easier if we could have allocated a heap block for each background task's stack.  But then we would get caught by the VBL "stack sniffer" routine, which would find SP pointing below ApplLimit, think that the stack had encroached into the heap zone, and politely bow out with system error 28 (stack collides with heap).
  18.  
  19. \            ================================
  20.  
  21. \ Here we define values for the space to be allocated for the Mops stacks for new tasks.  These values may be changed as required.  It's better to err on the big side.  Remember that any Toolbox calls can use a lot of data stack space.
  22.  
  23.  2000    value    R_SPACE
  24.  3000    value    S_SPACE
  25.  
  26. 16000    value    FGD_S_SPACE
  27.  
  28.     0    value    REAL_RP0
  29.     0    value    NEW_SP
  30.  
  31.  
  32. \ Possible task statuses:
  33.  
  34. type{  AWAKE  ASLEEP  WAITING  STOPPED  TERMINATED  AVAILABLE  CRASHED  }
  35.  
  36.  
  37. \ Constants for the 68000 opcodes we need:
  38.  
  39. $ 4EF9 constant    QJMP        \ JMP (absolute long)
  40. $ 6104 constant    QBSR        \ BSR  +4
  41.  
  42. objPtr    THIS_TASK        \ Points to the currently running task.
  43.  
  44. objPtr    TSK1            \ Used for tracking task queues.
  45. objPtr    TSK2            \  Will be set to class Task.
  46.  
  47.     0    value    STP        \ Stack allocation pointer.
  48.  
  49.  
  50. \            ====================
  51.  
  52. :code  SUSPEND
  53.     movem.l    d2-d7/a2/a5/a7,-(a6)        ; Save all relevant regs
  54.     movem.l    dic[ExtraLocals],d0-d7/a0/a1    ; Save ExtraLocals area
  55.     movem.l    d0-d7/a0/a1,-(a6)
  56.     movem.l    40(dic[ExtraLocals]),d0-d7/a0/a1
  57.     movem.l    d0-d7/a0/a1,-(a6)
  58.     move    dic[this_task],a1
  59.     move    a6,12(a1)    ; Save data stk ptr in task object
  60.     move    2(a1),a0
  61.     jmp    (a0)    ; JMP to LINK to restart next task.
  62. ;code
  63.  
  64. :code  RESTART
  65.     move    (a7)+,a1
  66.     subq    #2,a1    ; A1 -> task object addr
  67.     move    18(a1),dic[SP0]    ; Set SP0
  68.     move    22(a1),dic[RP0]    ; Set RP0
  69.     move    12(a1),a6    ; Set SP
  70.     lea    rel[this_task],a0    ; We may be based on A5, not set up yet
  71.     move.l    a1,(a0)
  72.     movem.l    (a6)+,d0-d7/a0/a1        ; Restore ExtraLocals area
  73.     movem.l    d0-d7/a0/a1,40(dic[ExtraLocals]
  74.     movem.l    (a6)+,d0-d7/a0/a1
  75.     movem.l    d0-d7/a0/a1,dic[ExtraLocals]
  76.     movem.l    (a6)+,d2-d7/a2/a5/a7        ; Restore saved regs
  77.     rts
  78. ;code
  79.  
  80.  
  81. : NoRoom    159 die  ;
  82.  
  83. :code  MOVE_TASKS    \ ( dist -- )
  84.     loc
  85.     pop.l    d1    ; D1 = distance to move
  86.     move.l    a6,d0
  87.     sub.l    d1,d0    ; D0 = tentative destination
  88.     cmp.l    glob[ApplLimit],d0
  89.     blo.s    dic[noRoom]
  90.     sub.l    d1,dic[SP0]
  91.     sub.l    d1,dic[RP0]
  92.     move.l    d0,a1    ; A1 -> destination
  93.     move.l    dic[real_RP0],d0
  94.     sub.l    a6,d0    ; D0 = #bytes to move
  95.     move.l    a7,a0
  96.     sub.l    d1,a0
  97.     move.l    a0,dic[new_SP]
  98.     move.l    a6,a0    ; A0 -> source
  99.     move.l    a1,a7    ; Set A7 low in case of an interrupt during
  100.     move.l    a1,a6    ;  the loop
  101.     addq.l    #8,d0
  102. loop    move.l    (a0)+,(a1)+
  103.     subq.l    #4,d0
  104. lptest    bgt.s    loop
  105.     move.l    dic[new_SP],a7
  106. ;code
  107.  
  108.  
  109. forward    CRASH
  110. forward    NOWHERE
  111.  
  112.  
  113. :class    TASK    super{ object }
  114.  
  115.     int    ENTRY
  116.     var    LINK
  117.     int    JMP_CODE
  118.     var    ^RESTART
  119.     var    ^SP
  120.     int    STATUS
  121.     var    tSP0
  122.     var    tRP0
  123.     var    QUEUE
  124.     var    QLINK
  125.     int    QSTATUS
  126.  
  127. ' this_task    set_to_class  task
  128. ' tsk1        set_to_class  task
  129. ' tsk2        set_to_class  task
  130.  
  131.  
  132. :m (SLEEP):    QJMP  put: entry  ;m
  133. :m SLEEP:        asleep  put: status   (sleep): self  ;m
  134. :m WAKE:        QBSR  put: entry    awake  put: status  ;m
  135.  
  136. :m NEXT:        get: link  ;m
  137. :m SETNEXT:    put: link  ;m
  138.  
  139. :m NEXTQ:        get: Qlink  ;m
  140. :m SETNEXTQ:    put: Qlink  ;m
  141.  
  142. :m ?RESUME:    \ ( status# -- b )
  143.     get: Qstatus  >=  dup
  144.     IF  wake: self  THEN  ;m
  145.  
  146. :m RELEASEQ:
  147.     nilP -> tsk1   get: queue  -> tsk2
  148.     BEGIN
  149.         tsk2  nilP =  ?EXIT
  150.         get: status  ?resume: tsk2
  151.         IF  ( resumed - remove from queue )
  152.             nextQ: tsk2
  153.             tsk1  nilP =
  154.             IF  put: queue  ELSE  setnextQ: tsk1  THEN
  155.         THEN
  156.         tsk2 -> tsk1  nextQ: tsk2  -> tsk2
  157.     AGAIN  ;m
  158.  
  159.  
  160. :m (WAIT):    \ ( status# -- )  Used by Wait: - see below.
  161.     put: Qstatus  waiting  put: status  releaseQ: self
  162.     (sleep): self  ;m
  163.  
  164. :m WAIT:    \ ( status# -- ).
  165.     \ If the given status# is greater than the status of SELF, the currently
  166.     \ running task is queued and put to sleep.  It will be woken when the
  167.     \ status of SELF goes to the given status# or higher.  If the given status#
  168.     \ is less than or equal to the status of SELF, we don't queue this_task,
  169.     \ since the condition it wishes to wait for has already occurred.  However
  170.     \ we make it do a "phantom" wait so that its own queue will be released.  
  171.     \ Logically it has waited, so any tasks waiting for it to wait, must be
  172.     \ released.
  173.  
  174.     dup  (wait): this_task
  175.     get: status  <=
  176.     IF    wake: this_task
  177.     ELSE
  178.         get: queue  setnextQ: this_task
  179.         this_task  put: queue  
  180.         next_task
  181.     THEN  ;m
  182.  
  183. :m STATUS:    get: status  ;m
  184. :m SETSTATUS:    put: status  releaseQ: self  ;m
  185.  
  186. :m ASSIGN:  { PC \ sptr -- }
  187.     get: status  available  <>  abort" Task not available"
  188.         \ Now we set up a "saved reg" image so that it looks like
  189.         \ we've been suspended with PC as the return address.
  190.     get: tSP0  -> sptr
  191.     -4 ++> sptr
  192.     get: tRP0 4-  ['] nowhere    over !    \ Initial higher rtn addr
  193.          4-  PC        over !    \ Initial rtn addr
  194.                     sptr !    \ Initial A7 = rtn stk ptr
  195.       -4 ++> sptr    modbase        sptr !    \ Initial A5 = modbase
  196.       -4 ++> sptr    -1        sptr !    \ Initial A2 - here's hoping!
  197.     -104 ++> sptr                \ Room for D2-D7 and ExtraLocals
  198.     sptr  put: ^SP
  199.     sleep: self  ;m
  200.  
  201. :m RESET:
  202.     available  put: status   ;m
  203.  
  204. :m DISPLACE:  { dist -- }
  205.     dist -: ^SP
  206.     dist -: tSP0
  207.     dist -: tRP0  ;m
  208.     
  209. \ NEW: sets up various items in this task object, which are dependent on
  210. \ the current Mops base and stack location.  These can't be determined
  211. \ until run time, especially under MultiFinder.  Each task must be
  212. \ initialized at run time with NEW:, starting with FOREGROUND.  Note:
  213. \ FOREGROUND MUST BE FIRST.
  214.  
  215. :m NEW:
  216.     ['] restart  put: ^restart
  217.     this_task  nilP =
  218.     IF  \ This is the first one, i.e FOREGROUND
  219.         ^base  setnext: self
  220.         ^base  -> this_task        \ Point LINK to ourselves
  221.         sp@ -> stp            \ Set initial stp ready for backgd tasks
  222.         SP0  put: tSP0
  223.         RP0  put: tRP0
  224.         RP0 -> real_RP0
  225.         wake: self
  226.     ELSE
  227.         R_space S_space +  dup  move_tasks
  228.         this_task -> tsk1        \ Ought to be Foreground
  229.         BEGIN
  230.             dup  displace: tsk1
  231.             next: tsk1  -> tsk1
  232.             tsk1 this_task =
  233.         UNTIL  drop
  234.         next: this_task  setnext: self
  235.         ^base  setnext: this_task    \ Link ourselves into chain
  236.         real_RP0  dup    put: tRP0
  237.         R_space -    put: tSP0
  238.         available  put: status
  239.         ['] crash  assign: self      \ In case we wake: prematurely
  240.         available  put: status      \ not really asleep
  241.     THEN  ;m
  242.  
  243. :m .Q:
  244.     get: queue  -> tsk1
  245.     tsk1 nilP =  IF  ." empty"  EXIT  THEN
  246.     BEGIN
  247.         tsk1 nilP =  ?EXIT
  248.         .id: tsk1  space  tsk1 .h space
  249.         nextq: tsk1  -> tsk1
  250.     AGAIN  ;m
  251.  
  252. :m .STATUS:
  253.     1000  get: status  getIndStr  type  ;m
  254.  
  255. :m DUMP:
  256.     .class: self  3 spaces  .id: self
  257.     ."   status: "  .status: self
  258.     ."   queue: "   .q: self  cr  ;m
  259.  
  260.  
  261. :m CLASSINIT:
  262.     qJMP  put: JMP_code
  263.     nilP  put: queue  ;m
  264.  
  265. ;class
  266.  
  267. \ Now create task FOREGROUND as the currently running task:
  268.  
  269. task  FOREGROUND
  270.  
  271. \ Now we set up the user hooks so that if we are multitasking, other tasks
  272. \ can keep running while windows are being dragged or menus being selected.
  273.  
  274. $ A30    constant    MENUHOOK
  275. $ 9F6    constant    DRAGHOOK
  276.  
  277. :proc RUN_THEM   suspend   ;proc
  278.  
  279. :proc (SFD)
  280.     drop        \ Dlg ptr not needed
  281.     i->l >r        \ Item #
  282.     word0 drop    \ Left for return result - don't need it now
  283.     r 100 =
  284.     IF  ( null event )  next_task  THEN
  285.     r> makeint  ;proc
  286.  
  287.  
  288. \ MULTI and SINGLE turn multitasking on and off respectively.  MULTI, among
  289. \ other things, redirects PAUSE to just switch tasks.  Without multitasking,
  290. \ we make PAUSE call next: fEvent, but with multitasking, this becomes
  291. \ the foreground task's sole responsibility, and we mustn't do it anywhere
  292. \ else.
  293.  
  294. : MULTI
  295.     ['] suspend  -> next_task  ['] suspend  -> pause
  296.     ['] run_them  dup  MenuHook !  DragHook !
  297.     ['] (sfd)  -> SFdlgHook
  298.     0 -> sleepticks  ;
  299.  
  300. : SINGLE
  301.     ['] null  -> next_task  ['] (pause)  -> pause
  302.     0 MenuHook !  0 DragHook !
  303.     0 -> SFdlgHook
  304.     20 -> sleepticks  ;
  305.  
  306.  
  307. \ Task manipulation
  308.  
  309. : (STOP)        (sleep): this_task  suspend   ;
  310. : STOP        stopped  setStatus: this_task
  311.         releaseQ: this_task  (stop)   ;
  312.  
  313. :f CRASH
  314.     BEGIN
  315. \        3 beep  ." !! no code assigned to task " .id: this_task
  316.         crashed  setStatus: this_task  (stop)
  317.     AGAIN  ;f
  318.  
  319. :f NOWHERE    \ A running task at its top level has really been called
  320.         \ from nowhere.  So we define NOWHERE so that if it returns,
  321.         \ it will actually go to NOWHERE, which is somewhere, not just
  322.         \ anywhere.  (I hope that's clear.)
  323.         \ We define this as normal termination of a task.  Any attempt
  324.         \  to wake: a terminated task causes CRASH to be executed.
  325.  
  326.     terminated  setStatus: this_task
  327.     releaseQ: this_task  (stop)  crash  ;f
  328.  
  329.  
  330. : .TASKS
  331.     foreground
  332.     BEGIN
  333.         dup dump: **  next: **
  334.         dup foreground =
  335.     UNTIL  drop   ;
  336.  
  337. : CLTSK        \ This is called on an abort.  We execute the normal
  338.         \ abort action, then stop the currently
  339.         \ running task and set its status to crashed, unless
  340.         \ it's Foreground (which we'd better not stop)!
  341.  
  342.     cl3                \ Previous abort action
  343.     this_task nilP =  ?EXIT        \ Out if nothing initialized
  344.     this_task foreground =  ?EXIT    \ Or if this is foreground
  345.     crashed  setStatus: this_task  ['] crash >r
  346.     releaseQ: this_task  (stop)  ;
  347.  
  348. ' clTsk -> abortVec
  349.  
  350. \ endload
  351.  
  352. \ TESTING:
  353.  
  354. task  T1   task  T2
  355.  
  356.  0 value    CNT
  357. 10 value    CNT1
  358.  0 value    CNT2
  359. 10 value    CNT3
  360.  
  361. file F
  362.  
  363. : HAHA
  364.     1 2 3
  365.     BEGIN
  366.         next_task  cnt
  367.         NIF    500 -> cnt  -1 ++> cnt1
  368.             ." haha " cr
  369. \            waiting wait: t2
  370.         ELSE    -1 ++> cnt
  371.         THEN
  372.     cnt1
  373.     NUNTIL  ;
  374.  
  375. : HOHO
  376.     -4 -5 -6
  377.     BEGIN
  378.         next_task  cnt2
  379.         NIF
  380.             800 -> cnt2  -1 ++> cnt3
  381.             ." hoho " cr
  382. \            waiting wait: t1
  383.         ELSE  -1 ++> cnt2
  384.         THEN
  385.     cnt3
  386.     NUNTIL  ;
  387.  
  388. : GO
  389.     new: foreground  new: t1  new: t2
  390. \    ['] haha  assign: t1
  391. \    ['] hoho  assign: t2
  392.     wake: t1  ( wake: t2 )
  393.     multi
  394. \    'type TEXT 1  stdGet: f  drop
  395. ;
  396.  
  397. : QQ    wake: t2  ;
  398.